home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGASIC / BASFILES.LZH / HNUMINPT.BAS < prev    next >
BASIC Source File  |  1988-09-10  |  4KB  |  209 lines
  1. '$INCLUDE:'QBTOOLS.INC'
  2. '' '$INCLUDE: 'qbtools2.inc'
  3.  
  4. 'CLS
  5.  
  6. 'NumericInput 1, 1, 1, 1, 1, 1, 1, 10, 1, 10000, 55, St$, Nv#, 5, 5, 7, 0, Ek%
  7.  
  8. SUB hNumericInput (hB AS hBuffer, Allowup%, Allowpu%, Allowdn%, Allowpd%, Allowrt%, Allowtb%, Allowes%, il%, yd%, MaxV#, MinV#, St$, Nv#, Xc%, Yc%, fc%, Bc%, Ek%) STATIC
  9.  
  10.     IF Nv# <> 0# THEN
  11.         St$ = STR$(Nv#)
  12.         Trim St$
  13.     END IF
  14.  
  15.     Insert% = 0                   '  Insert flag
  16.  
  17.     IF LEN(St$) > il% THEN        '  String is already too long
  18.         St$ = MID$(St$, 1, il%)    '  Make it the right size
  19.     END IF
  20.  
  21.     IF LEN(St$) < il% THEN        '  MUST make it equal to BLANKS
  22.         St$ = St$ + STRING$(il% - LEN(St$), 32)
  23.     END IF
  24.  
  25.     Xoff% = 1                     '  X-co-ordinate offset
  26.  
  27.     tmp$ = ""                     '  Erase it
  28.  
  29.  
  30.     Attr% = Attributes%(fc%, Bc%, 0, 0)
  31.     Ek% = 0
  32.                   
  33.     ColorPrint St$, Yc%, Xc%, Attr%
  34.  
  35.     WHILE Ek% = 0                 '  Until there's an exit
  36.  
  37.         IF Xoff% > il% THEN        '  Cursor positioner too long
  38.             Xoff% = il%
  39.         END IF
  40.  
  41.         IF INSTR(St$, " ") > 0 THEN
  42.             IF Xoff% > (INSTR(St$, " ")) THEN
  43.                 Xoff% = INSTR(St$, " ")
  44.             END IF
  45.         END IF
  46.  
  47.         IF Xoff% < 1 THEN
  48.             Xoff% = 1
  49.         END IF
  50.  
  51.         IF LEN(St$) < il% THEN        '  MUST make it equal to BLANKS
  52.             St$ = St$ + STRING$(il% - LEN(St$), 32)
  53.         END IF
  54.  
  55.         ColorPrint St$, Yc%, Xc%, Attr%
  56.  
  57.         IF Insert% = 1 THEN        '  Insert is on
  58.             LOCATE Yc%, Xc% + Xoff% - 1, 1, 0, 15
  59.         ELSE
  60.             LOCATE Yc%, Xc% + Xoff% - 1, 1, 7, 7
  61.         END IF
  62.  
  63.         w$ = ""                    '  Wait until there's a character
  64.       
  65.         WHILE w$ = ""
  66.             w$ = INKEY$
  67.         WEND
  68.       
  69.         LOCATE , , 0
  70.  
  71.         IF LEN(w$) = 1 THEN        '  Normal character
  72.             ch% = ASC(w$)
  73.  
  74.             IF yd% = 0 THEN
  75.                 IF ch% = 46 THEN
  76.                     ch% = 0
  77.                 END IF
  78.             ELSE
  79.                 IF ch% = 46 THEN
  80.                     IF INSTR(St$, ".") > 0 THEN
  81.                         ch% = 0
  82.                     END IF
  83.                 END IF
  84.             END IF
  85.  
  86.             SELECT CASE ch%
  87.  
  88.                 CASE 46, 48 TO 57    '  Normal numeric value
  89.  
  90.                     IF Insert% = 1 THEN
  91.                         IF Xoff% = 1 THEN
  92.                             St$ = CHR$(ch%) + MID$(St$, 1, il% - 1)
  93.                         ELSE
  94.                             IF Xoff% = il% THEN
  95.                                 MID$(St$, il%, 1) = CHR$(ch%)
  96.                             ELSE
  97.                                 St$ = MID$(St$, 1, Xoff% - 1) + CHR$(ch%) + MID$(St$, Xoff%)
  98.                                 St$ = LEFT$(St$, LEN(St$) - 1)
  99.                             END IF
  100.                         END IF
  101.                     ELSE
  102.                         MID$(St$, Xoff%, 1) = CHR$(ch%)
  103.                     END IF
  104.                     Xoff% = Xoff% + 1
  105.  
  106.                     CASE 8, 127          '  Back space
  107.                         IF Xoff% > 1 THEN
  108.                             IF Xoff% = il% THEN
  109.                                 MID$(St$, Xoff%, 1) = " "
  110.                                 MID$(St$, Xoff% - 1, 1) = " "
  111.                             ELSE
  112.                                 MID$(St$, Xoff% - 1, 1) = " "
  113.                             END IF
  114.                             Xoff% = Xoff% - 1
  115.                         END IF
  116.  
  117.                     CASE 13
  118.                         IF Allowrt% = 1 THEN '  Yes, return is ok
  119.                             Ek% = 5
  120.                         END IF
  121.  
  122.                     CASE 9
  123.                         IF Allowtb% = 1 THEN '  Yes, TAB is ok
  124.                             Ek% = 6
  125.                         END IF
  126.  
  127.                     CASE 27
  128.                         IF Allowes% = 1 THEN '  Yes, ESC is ok
  129.                             Ek% = 7
  130.                         END IF
  131.  
  132.                     CASE ELSE
  133.                   
  134.                 END SELECT
  135.  
  136.             ELSE
  137.                 ch% = ASC(MID$(w$, 2))  '  Extended character
  138.               
  139.                 SELECT CASE ch%
  140.  
  141.                     CASE 59, 84, 94, 104 '  Function key 1
  142.                         hFrameHandler hB
  143.  
  144.                     CASE 75              '  Left arrow
  145.                         Xoff% = Xoff% - 1
  146.  
  147.                     CASE 77              '  Right arrow
  148.                         Xoff% = Xoff% + 1
  149.  
  150.                     CASE 71              '  Home
  151.                         Xoff% = 0
  152.  
  153.                     CASE 79              '  End
  154.                         Xoff% = il%
  155.  
  156.                     CASE 82              '  Insert
  157.                         Insert% = 1 - Insert%
  158.  
  159.                     CASE 83              '  Delete
  160.                         IF Xoff% = il% THEN
  161.                             MID$(St$, il%, 1) = " "
  162.                         ELSE
  163.                             IF Xoff% = 1 THEN
  164.                                 St$ = MID$(St$, 2) + " "
  165.                             ELSE
  166.                                 St$ = MID$(St$, 1, Xoff% - 1) + MID$(St$, Xoff% + 1) + " "
  167.                             END IF
  168.                         END IF
  169.  
  170.  
  171.                     CASE 72              '  Up arrow
  172.                         IF Allowup% = 1 THEN '  Yes, UP is ok
  173.                             Ek% = 1
  174.                         END IF
  175.  
  176.                     CASE 73              '  Page up
  177.                         IF Allowpu% = 1 THEN '  Yes, PAGE UP is ok
  178.                             Ek% = 2
  179.                         END IF
  180.  
  181.                     CASE 81              '  Page down
  182.                         IF Allowpd% = 1 THEN '  Yes, PAGE DOWN is ok
  183.                             Ek% = 4
  184.                         END IF
  185.  
  186.                     CASE 80              '  Down arrow
  187.                         IF Allowdn% = 1 THEN '  Yes, DOWN is ok
  188.                             Ek% = 3
  189.                         END IF
  190.  
  191.                     CASE 32              '  ALT+D (Delete)
  192.                         St$ = STRING$(il%, 32)
  193.                         Xoff% = 1
  194.  
  195.                     CASE ELSE
  196.                 END SELECT
  197.             END IF
  198.  
  199.             IF Ek% <> 0 THEN
  200.                 Nv# = VAL(St$)
  201.                 IF Nv# > MaxV# OR Nv# < MinV# THEN
  202.                     Ek% = 0
  203.                 END IF
  204.             END IF
  205.         WEND
  206.  
  207.   END SUB
  208.  
  209.